unit ceGlobal;

interface

uses Classes, ceCommon, Graphics, ceConsts, SysUtils, IniFiles;

type
  TzCodeEditorStyle = (cesBorder);
  TzCodeEditorStyles = set of TzCodeEditorStyle;
  
  TzCodeElement = (ceNormal,
                   ceString,
                   ceInteger,
                   ceDouble,
                   ceReserved,
                   ceOperator,
                   ceComment,
                   ceTypes);

const
  ZCODEELMENT: array[TzCodeElement] of widestring = ('ceNormal',
                                                     'ceString',
                                                     'ceInteger',
                                                     'ceDouble',
                                                     'ceReserved',
                                                     'ceOperator',
                                                     'ceComment',
                                                     'ceTypes');
type
  PzCodeItem = ^TzCodeItem;
  TzCodeItem = record
    Element: TzCodeElement;
    Search: WideString;
    Bold: Boolean;
    Color: TColor;
  end;

  PzElement = ^TzElement;
  TzElement = record
    Value: widestring;
    Start: longword;
    CodeItem: PzCodeItem;
  end;

  TzCodes = class(TzList)
  private
    function GetElement(Index: longword): PzCodeItem;
  public
    function IsElement(aFunction: TzCodeElement; aSearch: widestring): longword; overload;
    function IsElement(aFunction: TzCodeElement): longword; overload;
    property Elements[Index: longword]: PzCodeItem read GetElement; default;
  end;

  TzHighlighter = class
  private
    fCodes: TzCodes;
    fTitle: widestring;
    fDesc: widestring;
  public
    constructor Create(aFile: string);
    procedure Add(aElement: TzCodeElement; aSearch: string; aColor: TColor; aBold: Boolean = false);
    procedure LoadBundle(aFile: string);
    procedure SaveBundle(aFile: string);
    procedure Parse(Element: PzElement);
    property Title: widestring read fTitle write fTitle;
    property Description: widestring read fDesc write fDesc;
  end;

  TzLines = class(TzList)
  private
    fLines: longword;
    function GetLines: longword;
    function GetElement(Index: longword): PzElement;
  public
    procedure Clear;
    property Lines: longword read GetLines;
    property Elements[Index: longword]: PzElement read GetElement; default;
  end;

  TzParser = class
  private
    fLines: TzLines;
    fText: widestring;
    fHighlighter: TzHighlighter;
    procedure Parser(p: PzElement);
    procedure ParseIt;
    procedure SetInput(const Value: widestring);
  public
    constructor Create(aHighlighter: string);
    property Input: widestring read fText write SetInput;
    property Output: TzLines read fLines write fLines;
  end;

implementation

{ TzLines }

procedure TzLines.Clear;
var
  i: longword;
begin
  fLines := 0;
  for i := 1 to Count do
    if Assigned(Item[i]) then
      Dispose(Item[i]);
  ClearIndexes;
end;

function TzLines.GetElement(Index: longword): PzElement;
begin
  Result := Item[Index];
end;

function TzLines.GetLines: longword;
var
  i: longword;
begin
  if fLines = 0 then
  begin
    Result := 0;
    for i := 1 to Count do
      if Elements[i]^.Value = NEWLINE then
        Inc(Result);
    Inc(Result);
    fLines := Result;
  end else
    Result := fLines;
end;

{ TzHighlighter }

procedure TzHighlighter.Add(aElement: TzCodeElement; aSearch: string; aColor: TColor; aBold: Boolean = false);
var
  p: PzCodeItem;
begin
  New(p);
  p^.Element := aElement;
  p^.Search := aSearch;
  p^.Color := aColor;
  p^.Bold := aBold;
  fCodes.Add(p);
end;

constructor TzHighlighter.Create(aFile: string);
begin
  fCodes := TzCodes.Create;
  if (aFile <> '') and FileExists(aFile) then
    LoadBundle(aFile);
end;

procedure TzHighlighter.LoadBundle(aFile: string);
var
  ini: TIniFile;
  f: TzCodeElement;
  s, t: string;
  c: TColor;
  b: boolean;
  i: longword;
begin
  ini := TIniFile.Create(aFile);
  fTitle := ini.ReadString('Parser', 'Title', 'Undefined');
  fDesc := ini.ReadString('Parser', 'Description', '');
  for f := Low(TzCodeElement) to High(TzCodeElement) do
  begin
    s := ini.ReadString(ZCODEELMENT[f], 'Search', '');
    c := ini.ReadInteger(ZCODEELMENT[f], 'Color', clWhite);
    b := ini.ReadBool(ZCODEELMENT[f], 'Bold', false);
    if s <> '' then
    begin
      i := 1;
      while (i < Length(s)) do
      begin
        t := '';
        while (s[i] <> ',') and (i < Length(s)) do
        begin
          t := t + s[i];
          inc(i);
        end;
        if t = 'KOMMA' then
          t := ',';
        Add(f, t, c, b);
        inc(i);
      end;
    end;
  end;
  ini.Free;
end;

procedure TzHighlighter.Parse(Element: PzElement);
var
  i: longword;
begin
{
  case Element^.Typ of
    ceInteger, ceString, ceComment: i := fCodes.IsElement(Element^.Typ);
  else i := fCodes.IsElement(Element^.Typ, Element^.Value);
  end;
  if i = 0 then Exit;
  Element^.Color := fCodes[i]^.Color;
  Element^.Bold := fCodes[i]^.Bold;
}
end;

procedure TzHighlighter.SaveBundle(aFile: string);
var
  ini: TIniFile;
  f: TzCodeElement;
  i: longword;
  s: string;
  c: TColor;
  b: boolean;
begin
  ini := TIniFile.Create(aFile);
  ini.WriteString('Parser', 'Title', fTitle);
  ini.WriteString('Parser', 'Description', fDesc);

  for f := Low(TzCodeElement) to High(TzCodeElement) do
  begin
    s := '';
    c := clWhite;
    b := false;
    for i := 1 to fCodes.Count do
    begin
      if fCodes[i]^.Element = f then
      begin
        if fCodes[i]^.Search = ',' then
          s := s + string('KOMMA')
        else
          s := s + string(fCodes[i]^.Search);

        if i < fCodes.Count then
          s := s + ',';
        c := fCodes[i]^.Color;
        b := fCodes[i]^.Bold;
      end;
    end;
    if s <> '' then
    begin
      ini.WriteString(ZCODEELMENT[f], 'Search', s);
      ini.WriteBool(ZCODEELMENT[f], 'Bold', b);
      ini.WriteInteger(ZCODEELMENT[f], 'Color', c);
    end;
  end;
  ini.Free;
end;

{ TzCodes }

function TzCodes.GetElement(Index: longword): PzCodeItem;
begin
  Result := Item[Index];
end;

function TzCodes.IsElement(aFunction: TzCodeElement; aSearch: widestring): longword;
begin
  for Result := 1 to Count do
  begin
    if (UpperCase(Elements[Result]^.Search) = UpperCase(aSearch)) then Exit;
  end;
  Result := 0;
end;

function TzCodes.IsElement(aFunction: TzCodeElement): longword;
begin
  for Result := 1 to Count do
  begin
    if (Elements[Result]^.Element = aFunction) then Exit;
  end;
  Result := 0;
end;

procedure TzParser.Parser(p: PzElement);
begin
{
  p^.Bold := false;
  p^.Color := clWhite;
  if not Assigned(fParser) then Exit;
  fParser.Parse(p);
}
end;

procedure TzParser.SetInput(const Value: widestring);
begin
  fText := Value;
  ParseIt;
end;

constructor TzParser.Create(aHighlighter: string);
begin
  fHighlighter := TzHighlighter.Create(aHighlighter);
end;

procedure TzParser.ParseIt;
var
  t: widestring;
  i: longword;
  check: boolean;
  comment_open: boolean;
  comment_start: string;
  string_open: boolean;

  function isNewline(s: string): boolean;
  begin
    Result := s = NEWLINE;
  end;

  function isSpace(s: string): boolean;
  begin
    Result := false;
    if string_open then Exit;
    Result := s = SPACE;
  end;

  function isOperator(s: string): boolean;
  begin
    Result := false;
    if string_open then Exit;
    Result := s[1] in ['.', ',', ';', ':', '(', ')', '[', ']', '<', '>', '=', '+', '-', '*', '/', '^'];
  end;

  function isOperator2(s: string): boolean;
  begin
    Result := false;
    if string_open then Exit;
    Result := (s = ':=') or (s = '<>');
  end;

  function isCommentStart(s: string): boolean;
  begin
    Result := false;
    if string_open then Exit;
    Result := (s = '{') or (s = '//') or (s = '(*');
    if Result then
      comment_start := s;
  end;

  function isCommentEnd(s: string): boolean;
  begin
    Result := false;
    if string_open then Exit;

    if comment_start = '//' then
      Result := s = #13
    else if comment_start = '{' then
      Result := (s = '}')
    else
      Result := (s = '*)');
  end;

  function Check1: boolean;
  begin
    Result := (not isNewLine(fText[i]))
      and (not isSpace(fText[i]))
      and (i <= Length(fText))
      and (not isCommentStart(fText[i]))
      and (not isCommentStart(fText[i] + fText[i + 1]))
      and (not isOperator2(fText[i] + fText[i + 1]))
      and (not isOperator(fText[i]));
  end;

  function Check2: boolean;
  begin
    Result := (not isNewline(fText[i])) and (not isCommentEnd(fText[i])) and (not isCommentend(fText[i] + fText[i + 1]));
  end;

var
  p: PzElement;
  ti: integer;
begin
  i := 1;
  fLines.Clear;
  comment_open := false;
  string_open := false;
  if Length(fText) = 0 then Exit;
  while (i <= Length(fText)) or ((i = 1) and (Length(fText) = 1)) do
  begin
    t := '';

    if comment_open then
      check := Check2
    else
      check := Check1;

    if i = Length(fText) then
    begin
      t := t + fText[i];
      inc(i);
    end else
      while check do
      begin
        if (fText[i] = '''') then
          string_open := not string_open;

        t := t + fText[i];
        inc(i);
        if comment_open then
          check := Check2
        else
          check := Check1;
      end;

    if (t <> '') then
    begin
      New(p);
      p^.Value := t;

      if comment_open then
      begin
        p^.Typ := ceComment;
        Parser(p);
      end else
      begin
        if TryStrToInt(t, ti) then
          p^.Typ := ceInteger
        else if ((t[1] = '''') and (t[Length(t)] = '''')) or (t[1] = '#') then
          p^.Typ := ceString
        else if (t = 'true') or (t = 'false') or (t = 'nil') then
          p^.Typ := ceInteger
        else
          p^.Typ := ceNormal;
      end;
      Parser(p);
      fLines.Add(p);
      t := '';
    end;

    if isCommentStart(fText[i]) then
    begin
      comment_open := true;
      New(p);
      p^.Value := fText[i];
      p^.Typ := ceComment;
      Parser(p);
      fLines.Add(p);
      inc(i);
    end
    else if isCommentStart(fText[i] + fText[i + 1]) then
    begin
      comment_open := true;
      New(p);
      p^.Value := fText[i] + fText[i + 1];
      p^.Typ := ceComment;
      Parser(p);
      fLines.Add(p);
      inc(i, 2);
    end
    else if isCommentEnd(fText[i]) or isCommentEnd(fText[i] + fText[i + 1]) then
    begin
      comment_open := false;
      if (comment_start = '{') then
      begin
        New(p);
        p^.Value := fText[i];
        p^.Typ := ceComment;
        Parser(p);
        fLines.Add(p);
        inc(i);
      end
      else if (comment_start = '(*') then
      begin
        New(p);
        p^.Value := fText[i] + fText[i + 1];
        p^.Typ := ceComment;
        fLines.Add(p);
        Parser(p);
        inc(i, 2);
      end else
        inc(i, 2);
      if comment_start = '//' then
      begin
        New(p);
        p^.Value := NEWLINE;
        p^.Typ := ceNormal;
        Parser(p);
        fLines.Add(p);
      end;
    end
    else if isNewLine(fText[i]) then
    begin
      New(p);
      p^.Value := NEWLINE;
      fLines.Add(p);
      inc(i);
      if fText[i] = #10 then
        inc(i);
    end
    else if isOperator2(fText[i] + fText[i + 1]) then
    begin
      New(p);
      p^.Value := fText[i] + fText[i + 1];
      p^.Typ := ceOperator;
      Parser(p);
      fLines.Add(p);
      inc(i, 2);
    end else if isOperator(fText[i]) then
    begin
      New(p);
      p^.Value := fText[i];
      p^.Typ := ceOperator;
      Parser(p);
      fLines.Add(p);
      inc(i);
    end else if isSpace(fText[i]) then
    begin
      New(p);
      p^.Value := SPACE;
      Parser(p);
      fLines.Add(p);
      inc(i);
    end;
  end;
  txt_height := 0;
end;

end.

